home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / lexscan / strutils.pas < prev   
Pascal/Delphi Source File  |  1996-04-08  |  12KB  |  474 lines
  1. ========
  2. Newsgroups: comp.lang.pascal.delphi.components
  3. Subject: Lexical Scanner [3/4]
  4. From: jbui@scd.hp.com (Joseph Bui)
  5. Date: 27 Jul 1995 16:59:40 GMT
  6.  
  7. {
  8.   ************************ STRUTILS.PAS ***********************
  9. }
  10.  
  11. {$define NO_EXCEPTIONS}
  12.  
  13. unit Strutils;
  14.  
  15. interface
  16.  
  17. uses
  18.    SysUtils, TypInfo;
  19.  
  20. const
  21.   Null = '';
  22.  
  23. type
  24.   TChars = set of char;
  25.  
  26. {basic string manipulation}
  27. function before(const Search, Find: string): string;
  28. function after(const Search, Find: string): string;
  29. function squish(const Search: string): string;
  30. function trim(const Search: string): string;
  31. function reverse(const Search: string): string;
  32. {library routine extensions}
  33. function RPos(const Find, Search: string): byte;
  34. function SetPos(const Search: string; {const Find: array of const}
  35.     const Find: TChars): byte;
  36. function SetRPos(const Search: string; {const Find: array of const}
  37.     const Find: TChars): byte;
  38. {complex string manipulation}
  39. function inside(const Search, Front, Back: string): string;
  40. function leftside(const Search, Front, Back: string): string;
  41. function rightside(const Search, Front, Back: string): string;
  42. {list manipulation}
  43. function last(const Search: string): string;
  44. function lrest(const Search: string): string;
  45. function extract(const Search: string; const Start, Count: byte;
  46.     const Separator, QuoteChar: char): string;
  47. function match(const Search, Find: string;
  48.     const Separator, QuoteChar: char): byte;
  49. {numeric strings}
  50. function IsAnInt(const Search: string): boolean;
  51. function IsAFloat(const Search: string): boolean;
  52. function IsANum(const Search: string): boolean;
  53. function StrToNum(const Search: string): extended;
  54. function StrType(const Search: string): TTypeKind;
  55.  
  56. implementation
  57.  
  58. const
  59. {
  60.   The values of BlackSpaces and WhiteSpaces should be changed for
  61.   non-USA users.
  62. }
  63.   BlackSpaces = [#33..#126];
  64.   WhiteSpaces = [#0..#32];
  65.   Digits = ['0'..'9'];
  66.   HexDigits = Digits + ['A'..'F', 'a'..'f'];
  67.  
  68. {**************** Basic String Manipulation *******************}
  69. {
  70.   before() returns everything before the first occurance of
  71.   Find in Search. If Find does not occur in Search, Search is
  72.   returned.
  73. }
  74. function before(const Search, Find: string): string;
  75. var
  76.   index: byte;
  77. begin
  78.   index:=Pos(Find, Search);
  79.   if index = 0 then
  80.     Result:=Search
  81.   else
  82.     Result:=Copy(Search, 1, index - 1);
  83. end;
  84.  
  85. {
  86.   after() returns everything after the first occurance of
  87.   Find in Search. If Find does not occur in Search, a null
  88.   string is returned.
  89. }
  90. function after(const Search, Find: string): string;
  91. var
  92.   index: byte;
  93. begin
  94.   index:=Pos(Find, Search);
  95.   if index = 0 then
  96.     Result:=Null
  97.   else
  98.     Result:=Copy(Search, index + Length(Find), 255);
  99. end;
  100.  
  101. {
  102.   squish() returns a string with all WhiteSpaces compressed into
  103.   single #32's. Leading and trailing WhiteSpaces are removed.
  104. }
  105. function squish(const Search: string): string;
  106. var
  107.   Index: byte;
  108.   AddSpace: boolean;
  109. begin
  110.   AddSpace:=False;
  111.   Result:=Null;
  112.   for Index:=1 to Length(Search) do
  113.     if Search[Index] in BlackSpaces then
  114.     begin
  115.       AppendStr(Result, Search[Index]);
  116.       AddSpace:=True;
  117.     end
  118.     else
  119.       if AddSpace then
  120.       begin
  121.         AppendStr(Result, #32);
  122.         AddSpace:=False;
  123.       end;
  124.   if Result[Length(Result)] = #32 then
  125.     Result[0]:=Chr(Length(Result) - 1);
  126. end;
  127.  
  128. {
  129.   trim() returns a string with all right and left WhiteSpaces removed.
  130. }
  131. function trim(const Search: string): string;
  132. var
  133.   Index: byte;
  134. begin
  135.   for Index:=1 to Length(Search) do
  136.     if Search[Index] in BlackSpaces then
  137.       Break;
  138.   Result:=Copy(Search, Index, 255);
  139.   for Index:=Length(Result) downto 1 do
  140.     if Search[Index] in BlackSpaces then
  141.       Break;
  142.   Result:=Copy(Result, 1, Index);
  143. end;
  144.  
  145. {
  146.   reverse() returns Search reversed by character.
  147. }
  148. function reverse(const Search: string): string;
  149. var
  150.   Index: byte;
  151. begin
  152.   Result:=Null;
  153.   for Index:=Length(Search) downto 1 do
  154.     AppendStr(Result, Search[Index]);
  155. end;
  156.  
  157.  
  158. {*************** Library Routine Extensions *******************}
  159. {
  160.   RPos() returns the index of the first character of the last
  161.   occurance of Find in Search. Returns 0 if Find does not occur
  162.   in Search. Like Pos() but searches in reverse.
  163. }
  164. function RPos(const Find, Search: string): byte;
  165. begin
  166.   Result:=Pos(reverse(Find), reverse(Search));
  167.   if Result > 0 then
  168.     Result:=Length(Search) - Result + 1;
  169. end;
  170.  
  171. {
  172.   SetPos() returns the index of the first occurance of an element
  173.   of Find in Search. If no elements of Find occur in Search then
  174.   0 is returned.
  175. }
  176. function SetPos(const Search: string; const Find: TChars): byte;
  177. begin
  178.   for Result:=1 to Length(Search) do
  179.     if Search[Result] in Find then
  180.       Exit;
  181.   Result:=0;
  182. end;
  183.  
  184. {
  185.   SetRPos() returns the index of the last occurance of an element
  186.   of Find in Search. If no elements of Find occur in Search then
  187.   0 is returned.
  188. }
  189. function SetRPos(const Search: string; const Find: TChars): byte;
  190. begin
  191.   for Result:=Length(Search) downto 1 do
  192.     if Search[Result] in Find then
  193.       Exit;
  194.   Result:=0;
  195. end;
  196.  
  197.  
  198. {***************** Complex String Manipulation ****************}
  199. {
  200.   inside() returns the string between the most inside nested
  201.   Front ... Back pair.
  202. }
  203. function inside(const Search, Front, Back: string): string;
  204. var
  205.   Index, Len: byte;
  206. begin
  207.   Len:=Pos(Back, Search);
  208.   Result:=Null;
  209.   if Len > 0 then
  210.   begin
  211.     Index:=RPos(Front, Copy(Search, 1, Len - 1));
  212.     if Index > 0 then
  213.       Result:=Copy(Search, Index + Length(Front), Len - Index - Length(Front));
  214.   end;
  215. end;
  216.  
  217. {
  218.   leftside() returns what is to the left of inside() or Search.
  219. }
  220. function leftside(const Search, Front, Back: string): string;
  221. var
  222.   Index, Len: byte;
  223. begin
  224.   Result:=Search;
  225.   Len:=Pos(Back, Search);
  226.   if Len > 0 then
  227.   begin
  228.     Index:=RPos(Front, Copy(Search, 1, Len - 1));
  229.     if Index > 0 then
  230.       Result:=Copy(Search, 1, Index - 1);
  231.   end;
  232. end;
  233.  
  234. {
  235.   rightside() returns what is to the right of inside() or Null.
  236. }
  237. function rightside(const Search, Front, Back: string): string;
  238. var
  239.   Index, Len: byte;
  240. begin
  241.   Result:=Null;
  242.   Len:=Pos(Back, Search);
  243.   if Len > 0 then
  244.   begin
  245.     Index:=RPos(Front, Copy(Search, 1, Len - 1));
  246.     if Index > 0 then
  247.       Result:=Copy(Search, Len + Length(Back), 255);
  248.   end;
  249. end;
  250.  
  251. {********************** List Manipulation *********************}
  252. {
  253.   last() returns the last continuous set of BlackSpaces in
  254.   Search. Note: Returns Null if the last characters of Search
  255.   are WhiteSpaces.
  256. }
  257. function last(const Search: string): string;
  258. var
  259.   Index: byte;
  260. begin
  261.   Result:=Null;
  262.   Index:=Length(Search);
  263.   while (Search[Index] in BlackSpaces) and (Index > 0) do
  264.     Dec(Index);
  265.   Result:=Copy(Search, Index + 1, 255);
  266. end;
  267.  
  268. {
  269.   lrest() returns everything last() does not return.
  270. }
  271. function lrest(const Search: string): string;
  272. var
  273.   Index: byte;
  274. begin
  275.   Result:=Null;
  276.   Index:=Length(Search);
  277.   while (Search[Index] in BlackSpaces) and (Index > 0) do
  278.     Dec(Index);
  279.   Result:=Copy(Search, 1, Index);
  280. end;
  281.  
  282. {
  283.   extract() returns a list of Count items starting with Start from
  284.   the Separator separated list Search. Extract ignores any separator
  285.   located between paired QuoteChar's.
  286. }
  287. function extract(const Search: string; const Start, Count: byte;
  288.     const Separator, QuoteChar: char): string;
  289. var
  290.   Index, Item: byte;
  291.   InQuote: boolean;
  292. begin
  293.   InQuote:=False;
  294.   Item:=1;
  295.   Result:=Null;
  296.   for Index:=1 to Length(Search) do
  297.   begin
  298.     InQuote:=(Search[Index] = QuoteChar) xor InQuote;
  299.     if Item in [Start..Start + Count - 1] then
  300.       AppendStr(Result, Search[Index]);
  301.     Item:=Item + Ord((Search[Index] = Separator) and not InQuote);
  302.     if Item = (Start + Count) then
  303.       Break;
  304.   end;
  305.   if Result[Length(Result)] = Separator then
  306.     Result[0]:=Chr(Length(Result) - 1);
  307. end;
  308.  
  309. {
  310.   match() returns the item position of Find in Search. If Find does not
  311.   occur in Search than 0 is returned. Search is a list of Separator
  312.   separated items. The item position of the first element of the list is
  313.   1. Match ignores any separators located between paired QuoteChars.
  314. }
  315. function match(const Search, Find: string;
  316.     const Separator, QuoteChar: char): byte;
  317. var
  318.   Index, Start: byte;
  319.   InQuote: boolean;
  320. begin
  321.   InQuote:=False;
  322.   Result:=1;
  323.   Start:=1;
  324.   if Search = Find then
  325.     Exit;
  326.   for Index:=1 to Length(Search) do
  327.   begin
  328.     InQuote:=(Search[Index] = QuoteChar) xor InQuote;
  329.     if (Search[Index] = Separator) and not InQuote then
  330.     begin
  331.       if Find = Copy(Search, Start, Index - Start) then
  332.         Exit;
  333.       Inc(Result);
  334.       Start:=Index + 1;
  335.     end;
  336.   end;
  337.   Result:=0;
  338. end;
  339. {********************* Numeric Strings ************************}
  340. {
  341.   IsAnInt() returns true if Search can be converted to an
  342.   integer. Uses exceptions unless NO_EXCEPTIONS is defined.
  343. }
  344. function IsAnInt(const Search: string): boolean;
  345. var
  346.   Index: byte;
  347.   Started: boolean;
  348.   IsHex: boolean;
  349. begin
  350. {$ifdef NO_EXCEPTIONS}
  351.   Result:=True;
  352.   Started:=False;
  353.   IsHex:=False;
  354.   for Index:=1 to Length(Search) do
  355.   begin
  356.     if not Result then
  357.       Exit;
  358.     if Started then
  359.       Result:=(Search[Index] in Digits) or
  360.           (IsHex and (Search[Index] in HexDigits))
  361.     else
  362.       if (Search[Index] in BlackSpaces) then
  363.       begin
  364.         Started:=not (Search[Index] in ['+', '-']);
  365.         IsHex:=Search[Index] = '$';
  366.         Result:=(IsHex and (Index < Length(Search))) or (not Started) or (Search[Index] in Digits);
  367.       end;
  368.   end;
  369.   if not Started then Result:=False;
  370. {$else}
  371.   try
  372.     StrToInt(Search);
  373.     Result:=True;
  374.   except
  375.     on EConvertError do
  376.       Result:=False;
  377.   end;
  378. {$endif}
  379. end;
  380.  
  381. {
  382.   IsAFloat() returns true if Search can be converted to a floating point.
  383.   Uses exceptions unless NO_EXCEPTIONS is defined.
  384. }
  385. function IsAFloat(const Search: string): boolean;
  386. var
  387.   Index: byte;
  388.   Allowed: set of char;
  389.   Started: boolean;
  390. begin
  391. {$ifdef NO_EXCEPTIONS}
  392.   Result:=True;
  393.   Started:=False;
  394.   Allowed:=Digits + ['+', '-', '.'] + WhiteSpaces;
  395.   for Index:=1 to Length(Search) do
  396.   begin
  397.     Result:=(Search[Index] in Allowed);
  398.     if not Result then
  399.       Exit;
  400.     if (not Started) and (Search[Index] in BlackSpaces) then
  401.     begin
  402.       Started:=True;
  403.       Allowed:=Allowed + ['E', 'e'] - ['+', '-'];
  404.       if (Search[Index] in ['+', '-']) and
  405.           ((Index = Length(Search)) or
  406.           (Search[Index + 1] in WhiteSpaces)) then
  407.       begin
  408.         Result:=False;
  409.         exit;
  410.       end;
  411.     end;
  412.     case (Search[Index]) of
  413.       #0..#33 : if Started then Allowed:=WhiteSpaces;
  414.       '+', '-' : Allowed:=Allowed - ['+', '-'];
  415.       '.' : Allowed:=Allowed - ['.'];
  416.       '0'..'9' : Allowed:=Allowed - ['+', '-'];
  417.       'E', 'e' : Allowed:=Allowed + ['+', '-'] - ['E', 'e', '.'];
  418.     end;
  419.   end;
  420.   if not Started then Result:=False;
  421. {$else}
  422.   try
  423.     StrToFloat(Search);
  424.     Result:=True;
  425.   except
  426.     on EConvertError do
  427.       Result:=False;
  428.   end;
  429. {$endif}
  430. end;
  431.  
  432. {
  433.   IsANum() returns true if Search can be converted to either
  434.   a floating point or an integer. Uses exceptions unless
  435.   NO_EXCEPTIONS is defined.
  436. }
  437. function IsANum(const Search: string): boolean;
  438. begin
  439.   Result:=IsAnInt(Search) or IsAFloat(Search);
  440. end;
  441.  
  442. {
  443.   StrToNum() returns Search as a floating point value. StrToNum
  444.   works on numbers in pascal hex notation. StrToNum will raise
  445.   an exception if Search can not be converted.
  446. }
  447. function StrToNum(const Search: string): extended;
  448. begin
  449.   try
  450.     Result:=StrToFloat(Search);
  451.   except
  452.     Result:=StrToInt(Search);
  453.   end;
  454. end;
  455.  
  456. {
  457.   StrType() returns tkInteger if Search can be converted to an
  458.   integer, tkFloat if Search can be converted to a floating
  459.   point and tkString otherwise.
  460. }
  461. function StrType(const Search: string): TTypeKind;
  462. begin
  463.   if IsAnInt(Search) then
  464.     Result:=tkInteger
  465.   else
  466.     if IsAFloat(Search) then
  467.       Result:=tkFloat
  468.     else
  469.       Result:=tkString;
  470. end;
  471.  
  472. end.
  473.  
  474.